Deutsche Edition 1/Deutsche Edition 1.iso/amok/041-050/amok49/oprof/txt/text.mod

Text File | 1993-11-04 | 6KB | 264 lines

(*
  :Program.       Text.mod (OProf)
  :Author.        Volker Rudolph
  :Address.       Lettow-Vorbeck-Str. 11 / 6750 Kaiserslautern 26
  :Phone.         [phone]
  :Version.       1.22
  :Date.          4.11.90
  :Copyright.     Volker Rudolph (Shareware)
  :Language.      Oberon
  :Translator.    Oberon V1.17.1
  :Imports.       MicroTimer, Printf
  :Contents.      Laufzeit-Statistiken über Programme
*)

MODULE Text;

IMPORT e:Exec,ob:OberonLib,p:Printf,l:Lists,as:ASCII,s:SYSTEM,st:Strings,
       ex:Expressions,pr:ProfRunTime;

(* --- EXPORTED -------------------------------------------------------------- *)

CONST
  (* Keywords *)
  end       * =  0;
  return    * =  1;
  begin     * =  2;
  procedure * =  3;
  if        * =  4;
  case      * =  5;
  while     * =  6;
  with      * =  7;
  record    * =  8;
  loop      * =  9;
  module    * = 10;
  close     * = 11;
  halt      * = 12;
  import    * = 13;

TYPE
  MinExNodePtr * = POINTER TO MinExNode;
  MaxExNodePtr * = POINTER TO MaxExNode;

  ExNode * = RECORD (l.Node)
               semicolon * :BOOLEAN;
               len       * :INTEGER;
             END;

  MinExNode * = RECORD (ExNode)
                  expression * :ex.MinExpression;
                END;

  MaxExNode * = RECORD (ExNode)
                  expression * :ex.MaxExpressionPtr;
                END;

VAR
  ExList * :l.List;

(*
  PROCEDURE ReadText(name:ARRAY OF CHAR):BOOLEAN;
  PROCEDURE WriteText():BOOLEAN;
  PROCEDURE RemText;
  PROCEDURE AddExpression(VAR str:ARRAY OF CHAR;at:l.NodePtr;semicolon:BOOLEAN);
  PROCEDURE FindKeyWord(searchTypes:SET;
                        VAR node:l.NodePtr;
                        VAR key:INTEGER
                       ):BOOLEAN;
*)

(* --- NOT EXPORTED ---------------------------------------------------------- *)

CONST
  OutOfMem = "Out of memory error";

VAR
  keyWord:ARRAY import+1,15 OF CHAR;

(* -------------------------------------------------------------------------- *)

PROCEDURE RemText*;
VAR
  head:l.NodePtr;
BEGIN
  head := l.RemHead(ExList);
  WHILE head # NIL DO
    IF head^ IS MaxExNode THEN
      DISPOSE(head(MaxExNode).expression);
    END; (* IF *)
    DISPOSE(head);
    head := l.RemHead(ExList);
  END; (* WHILE *)
END RemText;

(* -------------------------------------------------------------------------- *)

PROCEDURE ReadText*(name:ARRAY OF CHAR):BOOLEAN;
VAR
  minEx:MinExNodePtr;
  maxEx:MaxExNodePtr;
  expression:ex.MaxExpression;
  semicolon:BOOLEAN;
  noMem:BOOLEAN;
  len:INTEGER;
BEGIN
  IF ~ex.Open(name,ob.wbStarted) THEN
    RETURN FALSE;
  END; (* IF *)

  noMem := FALSE;

  REPEAT
    ex.ReadExpression(expression,len,semicolon);

    IF len # 0 THEN
      IF len < ex.MinExpressionLen THEN
        NEW(minEx);
        noMem := minEx = NIL;
        IF ~noMem THEN
          minEx.semicolon := semicolon;
          minEx.len := len;
          e.CopyMem(expression,minEx.expression,len);
          l.AddTail(ExList,minEx);
        END; (* IF *)
      ELSE
        NEW(maxEx);
        noMem := maxEx = NIL;
        IF ~noMem THEN
          ob.New(maxEx.expression,len);
          e.CopyMem(expression,maxEx.expression^,len);
          maxEx.semicolon := semicolon;
          maxEx.len := len;
          l.AddTail(ExList,maxEx);
        END; (* IF *)
      END; (* IF *)
    END; (* IF *)
  UNTIL (len = 0) OR noMem;

  RETURN ~noMem;
END ReadText;

(* -------------------------------------------------------------------------- *)

PROCEDURE WriteText*():BOOLEAN;
VAR
  node:l.NodePtr;
  end,ok:BOOLEAN;
BEGIN
  ok := TRUE;
  node := l.Head(ExList);
  WHILE (node # NIL) & ok DO
    IF node^ IS MinExNode THEN
      ok := ex.WriteExpression(node(MinExNode).expression,node(MinExNode).len);
    ELSIF node^ IS MaxExNode THEN
      ok := ex.WriteExpression(node(MaxExNode).expression^,node(MaxExNode).len);
    END; (* IF *)
    end := l.Next(node);
  END; (* WHILE *)

  RETURN ok;
END WriteText;

(* -------------------------------------------------------------------------- *)

(* $CopyArrays- *)
PROCEDURE AddExpression*(str:ARRAY OF CHAR;at:l.NodePtr;semicolon:BOOLEAN);
VAR
  newMaxEx:MaxExNodePtr;
  len:INTEGER;
BEGIN

  len := st.Length(str);

  NEW(newMaxEx);
  pr.Assert(newMaxEx # NIL,OutOfMem);
  ob.New(newMaxEx.expression,len);
  pr.Assert(newMaxEx.expression # NIL,OutOfMem);

  newMaxEx.semicolon := semicolon;
  newMaxEx.len := len;
  e.CopyMem(str,newMaxEx.expression^,len);


  IF at # NIL THEN
    l.AddBehind(ExList,newMaxEx,at);
  ELSE
    l.AddHead(ExList,newMaxEx);
  END; (* IF *)

END AddExpression;

(* -------------------------------------------------------------------------- *)

PROCEDURE FindKeyWord*(searchTypes:SET;
                       VAR node:l.NodePtr;
                       VAR key:INTEGER
                      ):BOOLEAN;
VAR
  oldNode:l.NodePtr;
  ok:BOOLEAN;

  (* $CopyArrays- *)
  PROCEDURE Compare(str:ARRAY OF CHAR;key:INTEGER):BOOLEAN;
  VAR
    i:INTEGER;
  BEGIN
    i := 0;
    WHILE keyWord[key,i] # as.nul DO
      IF str[i] # keyWord[key,i] THEN
        RETURN FALSE;
      END; (* IF *)
      INC(i);
    END; (* WHILE *)
    RETURN TRUE;
  END Compare;

BEGIN
  oldNode := node;
  WHILE node # NIL DO
    key := end;
    WHILE (key <= import) DO
      IF key IN searchTypes THEN
        IF (node IS MaxExNode) THEN
          IF Compare(node(MaxExNode).expression^,key) THEN
            RETURN TRUE;
          END; (* IF *)
        ELSE
          IF Compare(node(MinExNode).expression ,key) THEN
            RETURN TRUE;
          END; (* IF *)
        END; (* IF *)
      END; (* IF *)
      INC(key);
    END; (* WHILE *)
    ok := l.Next(node);
  END; (* WHILE *)
  node := oldNode;
  RETURN FALSE;

END FindKeyWord;

(* -------------------------------------------------------------------------- *)

BEGIN
  l.Init(ExList);

  keyWord[end]       := "END";
  keyWord[begin]     := "BEGIN";
  keyWord[return]    := "RETURN";
  keyWord[procedure] := "PROCEDURE";
  keyWord[module]    := "MODULE";
  keyWord[if]        := "IF";
  keyWord[case]      := "CASE";
  keyWord[with]      := "WITH";
  keyWord[while]     := "WHILE";
  keyWord[close]     := "CLOSE";
  keyWord[import]    := "IMPORT";
  keyWord[record]    := "RECORD";
  keyWord[halt]      := "HALT";
  keyWord[loop]      := "LOOP";

CLOSE
  RemText;
END Text.